00100	COMMENT/
00200		                       SAIL ACCESSIBLE
00300		    DYNAMIC STORAGE ALLOCATION ROUTINES FOR USER FAST BANDS

00400	
00500	Allocate	BLK	←	DRUMA(SIZE);
00600	Input		DRUMI(ADR,BLK);
00700	Output		DRUMO(ADR,BLK);
00800	Release		DRUMR(BLK);			/
00900	
01000	TITLE	DRUM
01100	INTERN	DRUMA,DRUMI,DRUMO,DRUMR
01200	
01300	;Current Position on the list.
01400		BLKPTR:	0
01500		BAND:	0
01600		SECTOR:	0
01700		FBCNT:	0
01800	;Fast Band free storage Block List.
01900		FBBLST:	BLOCK =32
02000		FREE:	BLOCK =1000
02100	COMMENT/
02200		The fast band block list contains 33 lists of blocks, 0  thru
02300	31  are  band  lists,  32 is the free list.  The left half of a block
02400	word contains the size of the block, a negative size  indicates  that
02500	the block is allocated.  The right half of a blk word is a pointer to
02600	the next blk, a zero ptr indicates end of list./
02700		P←←17		;SAIL PDL AC.
02800	INITIALIZATION:	0
02900		SETZ
03000		CALLI	400010
03100		JRST	[OUTSTR [ASCIZ/NO BANDS AVAILABLE./] ↔ HALT]
03200	;INIT BAND LISTS.
03300		HRLZI	=2432
03400		MOVEM	FBBLST
03500		MOVE	[XWD FBBLST,FBBLST+1]
03600		BLT	FBBLST+=31
03700	;INIT FREE LIST.
03800		MOVE	1,[XWD -=999,FREE+1]
03900		HRRZM	1,-1(1)
04000		AOBJN	1,.-1
04100	;SET THE INIT FLAG AND RETURN.
04200		SETOM	INITFLG
04300		MOVEI	FBBLST
04400		MOVEM	BLKPTR
04500		SETZM	BAND
04600		SETZM	SECTOR
04700		SETZM	FBCNT
04800		JRST	@INITIALIZATION
04900	INITFLG:	0
     

00100	; DRUM INPUT AND OUTPUT TAKE TWO INTEGER ARGUMENTS (ADR,BLK).
00200	; ADR IS THE ADDRESS OF THE FIRST WORD OF THE BLK - POINT(36,XARRY[1],35).
00300	; BLK CONTAINS THE BAND NUMBER IN BITS 0 - 5,   6 BITS,
00400	; BLK CONTAINS THE SECTOR ADDR IN BITS 6 -17,  12 BITS,
00500	; BLK CONTAINS THE WORD LENGTH IN BITS 18-35,  18 BITS,
00600		OPDEF	FBREAD[706B8]
00700		OPDEF	FBWRIT[707B8]
00800	DRUMI:	SKIPA	1,[-1]
00900	DRUMO:	SETZ	1,
01000		MOVE	-2(P)
01100		HRRZM	ARG1			;CORE ADDRESS OF THE BLOCK.
01200		MOVE	-1(P)
01300		JUMPE	EX			;ZERO BLK ARG - NO OPERATION.
01400		HRRZM	ARG2			;NUMBER OF WORDS.
01500		HLRZS
01600		DPB	[POINT 12,ARG3,35]	;FIRST SECTOR OF THE BLOCK.
01700		LSH	-14			;BAND NUMBER.
01800		JUMPE	1,[
01900		FBWRIT	ARG1
02000		OUTSTR	[ASCIZ/FB WRITE ERROR.
02100	/]↔	JRST	EX]
02200		FBREAD	ARG1
02300		OUTSTR	[ASCIZ/FB READ ERROR.
02400	/]↔EX:	SUB	P,[XWD 3,3]
02500		JRST	@3(P)			;RETURN.
02600	ARG1:	0
02700	ARG2:	0
02800	ARG3:	0
     

00100	;ALLOCATE PROCEDURE DRUMA (INTEGER WORDS).
00200		SIZE	←←	11;	number of sectors needed.
00300		SIZ	←←	10;	number of sectors in this blk.
00400		BP	←←	13;	blk pointer.
00500		F	←←	14;	head of the free list.
00600		SECT	←←	15;	sector address of this blk.
00700	DRUMA:	SKIPN	INITFLG
00800		JSR	INITIALIZATION
00900		MOVE	SIZE,	-1(P)
01000		ASH	SIZE,	-5
01100		AOSG	SIZE		; NUMBER OF SECTORS NEEDED.
01200		JRST		[OUTSTR [ASCIZ/FB BLK SIZE ERROR./]↔JRST ERROR]
01300		CAILE	SIZE,	=2432
01400		JRST		[OUTSTR [ASCIZ/FB BLK TOO LARGE./]↔JRST ERROR]
01500	;SEARCH FOR FIRST FIT.
01600		MOVE	BP,	BLKPTR
01700		MOVE	SECT,	SECTOR
01800	L:	HLRE	SIZ,	(BP)
01900		CAMGE	SIZ,	SIZE
02000	;BLOCK EITHER NOT BIG ENOUGH OR ALREADY IN USE.
02100		JRST	[
02200		MOVMS		SIZ
02300		ADD	SECT,	SIZ	;SECTOR ADDRESS OF NEXT BLK.
02400		HRRZ	BP,	(BP)	; CDR THE LIST.
02500	;TEST FOR NO-FIT-FOUND EVENT.
02600	FULL:	CAMN	BP,	BLKPTR
02700	;GET ANOTHER BAND IF WE CAN.
02800		JRST	[
02900		AOS	BP,	FBCNT
03000		CAILE	BP,	37
03100		JRST		[OUTSTR [ASCIZ/DRUM BLK ALLOC FAILED - DRUM FULL.
03200	/]↔	JRST 		ERROR]
03300		CALLI	BP,	400010
03400		JRST	[OUTSTR [ASCIZ/NO BANDS AVAILABLE./] ↔ HALT]
03450		MOVE	BP,	FBCNT
03500		JRST		NEWBP]
03600		JUMPN	BP,	L
03700	;END OF LIST, GET NEXT BAND.
03800		MOVE	BP,	BAND
03900		AOS		BP
04000		CAMLE	BP,	FBCNT
04100		SETZ	BP,
04200	NEWBP:	MOVEM	BP,	BAND
04300		ADDI	BP,	FBBLST
04400		SETZ	SECT,
04500		JRST		FULL]
     

00100	;BLOCK FOUND.
00200		CAMG	SIZ,	SIZE
00300	;EXACT FIT.
00400		JRST	[
00500		MOVNS		SIZE		;NEGATE AND STORE SIZE FIELD.
00600		HRLM	SIZE,	(BP)
00700		MOVEM	BP,	BLKPTR		;SAVE LIST PTR AND SECTOR.
00800		MOVEM	SECT,	SECTOR
00900		JRST		PACKUP]
01000	;BLOCK FOUND WITH SPACE REMAINING.
01100	; GET A WORD OFF THE FREE LIST.
01200		SKIPN	F,	FREE
01300		JRST		[OUTSTR [ASCIZ/TOO MANY FB BLKS - FFBLST OVERFLOW.
01400	/]↔	JRST		ERROR]
01500		HRRZ		(F)
01600		MOVEM		FREE	;NEW HEAD OF THE FREE LIST.
01700	;STASH THE BP PTR AND SECTOR ADDR OF THE BLK REMAINING.
01800		MOVEM	F,	BLKPTR	;POINTER TO BLK REMAINING.
01900		MOVE		SECT
02000		ADD		SIZE
02100		MOVEM		SECTOR
02200	;COMPUTE AND STORE SIZE FIELDS IN THE FB BLK LST.
02300		MOVNS		SIZE
02400		HRLM	SIZE,	(BP)	;SIZE OF THE BLK BEING ALLOCATED.
02500		ADD	SIZ,	SIZE
02600		HRLM	SIZ,	(F)	;SIZE OF THE BLK REMAINING.
02700	;INSERT A BLK INTO THE FB BLK LIST.
02800		MOVE		(BP)
02900		HRRM		(F)	;PTR IN BLK REMAINING TO NEXT BLK.
03000		HRRM	F,	(BP)	;PTR IN BLK ALLOCATED TO BLK REMAINING.
03100	;PACK UP A FB BLK POINTER AND RETURN.
03200	PACKUP:	MOVE	1,	BAND
03300		LSH	1,	=12
03400		IOR	1,	SECT
03500		MOVSS		1
03600		HRR	1,	-1(P)		;SIZE IN WORDS.
03700		SKIPA
03800	ERROR:	SETZ	1,			;ERROR RETURN ZERO BLK PTR.
03900		SUB	P,	[XWD 2,2]
04000		JRST		@2(P)		;RETURN.
     

00100	;SUBROUTINE ACCUMULATORS.
00200		TMP1	←←	4
00300		TMP2	←←	5
00400		PTR1	←←	6
00500		PTR2	←←	7
00600	;MERGE TWO BLOCKS OF FB STORAGE.
00700	MERGE:	0
00800	;ZERO PTR INDICATES END OF LIST.
00900		JUMPE	PTR1,	@MERGE
01000		HRRZ	PTR2,	(PTR1)
01100		JUMPE	PTR2,	@MERGE
01200	;NEGATIVE SIZE FIELD INDICATES BLK IN USE.
01300		SKIPG	TMP1,	(PTR1)
01400		JRST		@MERGE
01500		SKIPG	TMP2,	(PTR2)
01600		JRST		@MERGE
01700	;ADD SIZES AND STASH IN FIRST BLK.
01800		HLRZS		TMP1
01900		HLRZS		TMP2
02000		ADD	TMP1,	TMP2
02100		HRLM	TMP1,	(PTR1)
02200	;TAKE THE SECOND BLK OFF THE LIST.
02300		HRRZ		(PTR2)
02400		HRRM		(PTR1)
02500	; ...AND CONS IT ONTO THE FREE LIST.
02600		HRRZ		FREE
02700		HRRZM		(PTR2)
02800		HRRZM	PTR2,	FREE
02900	;TRY FOR ANOTHER MERGE.
03000		JRST		MERGE+1
     

00100	;RELEASE PROCEDURE DRUMR (INTEGER BLK).
00200	DRUMR:	SETZ	PTR1,
00300		MOVE	2,	-1(P)
00400		SETZ	1,
00500		LSHC	1,	6		;BAND NUMBER IN AC1.
00600	;SECTOR NUMBER IN AC2.
00700		LSH	2,	-=24
00800	;DO BAND AND SECTOR MATCH THE BLK JUST ALLOCATED ON AN EXACT SIZE MATCH ?
00900		CAME	1,	BAND
01000		JRST		.+6
01100		CAME	2,	SECTOR
01200		JRST		.+4
01300	; ...WELL I DIDN'T WANT TO GET CLOBBERED BY A RARE SPECIAL CASE.
01400		MOVEI		FBBLST
01500		MOVEM		BLKPTR
01600		SETZM		SECTOR
01700	;HEAD OF THIS BLK'S BAND LIST IN BP AND FIRST SECTOR IS ZERO.
01800		MOVEI	BP,	FBBLST(1)
01900		SETZ	SECT,
02000	;SEARCH DOWN THE BAND LIST FOR THE BLK TO BE RELEASED.
02100	TEST:	CAMN	SECT,	2
02200		JRST		FOUND
02300		CAML	SECT,	2
02400		JRST		[OUTSTR [ASCIZ/ERROR, FB BLK NOT FOUND.
02500	/]↔	JRST		ERROR]
02600		JUMPE	BP,	[OUTSTR [ASCIZ/ERROR - FB BLK NOT FOUND.
02700	/]↔	JRST		ERROR]
02800	;ADVANCE THE SECTOR ADDRESS.
02900		HLRE	SIZE,	(BP)
03000		MOVMS		SIZE
03100		ADD	SECT,	SIZE
03200	;CDR THE LIST.
03300		MOVE	PTR1,	BP
03400		HRRZ	BP,	(BP)
03500		JRST		TEST
03600	;RELEASE THE BLOCK.
03700	FOUND:	HLRE	SIZE,	(BP)
03800		MOVMS		SIZE
03900		HRLM	SIZE,	(BP)
04000	;CALL THE BLK MERGER.
04100		SKIPN		PTR1
04200		MOVE	PTR1,	BP
04300		JSR		MERGE
04400	;RETURN.
04500		SUB	P,	[XWD 2,2]
04600		JRST		@2(P)
04700	
04800	END